home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1995 November / Macworld Nov ’95.toast / Developers / Selection ƒ 2.5 / primitiveWin < prev    next >
Encoding:
Text File  |  1995-02-04  |  7.2 KB  |  282 lines  |  [TEXT/MSET]
  1. \ 12Jun93 DBH  Changed grow: and zoom: to match Chernicoff.
  2.     \ SETUP_DRAW:    clear: portRect
  3.     \ removed UPDATE: setContRect: and contrect ivar, and cls from initnewwindow:
  4. \ 13Jun93 DBH Added set: super to all mouse-down entry points.  This solved several
  5.     \ window update/draw problems with windoids and doesn't seem to hurt other uses.
  6. \ 04Jul93 DBH Made bndsRect an ivar, added setbounds:, and changed new: parameters.
  7. \ 07Dec93 DBH  added erase: method.
  8.  \ 08Jan94 DBH changed new: to handle case when we are switched out.
  9.  \ changed close: to handle case when we are switched out.
  10.  \ 28Oct94 dbh deleted addr: references
  11.  
  12. (*
  13.  
  14. A primitive window class. No frills.  Won't work as a console.  Note that
  15. this class is redundant with class window.  We should be able to replace
  16. class window with this as long as we *never* try to use fwind.
  17. *)
  18.  
  19. :class primitiveWin  super{ grafPort }
  20.  
  21. record{                        \ 07Jan95 dbh
  22. $ 2C    bytes    wind1       \ unmapped
  23.         handle    CTLLIST        \ 1st ctl \ 07Jan95 dbh
  24. $ 0C    bytes    wind2       \ unmapped \ 07Jan95 dbh
  25.         rect    GROWRECT    \ grow size rectangle
  26.         rect    DRAGRECT    \ drag limits rect
  27.         rect    bndsRect
  28.  
  29.         bool    GROWFLG        \ true if growable
  30.         bool    DRAGFLG        \ true if draggable
  31.         bool    ALIVE        \ true if space exists
  32.         bool    zoomFlg
  33. } \ 07Jan95 dbh
  34.  
  35. private
  36.  
  37. :m SETLIMITS:    \ Sets GrowRect and DragRect to reasonable default values according
  38.         \ to the current screen size at the time the grow or drag is done.
  39.         \ Programs such as SteppingOut can change the screen size while a
  40.         \ window is open!
  41.  
  42.     screenbits  put: dragRect
  43.     40 40 getBot: dragRect  put: growRect
  44.     4 4 inset: dragRect  ;m
  45.  
  46. :m ?DISABLE_ACTW:    \ Deactivates the currently active window before a New:
  47.             \ or GetNew: call, if there is a currently active Mops 
  48.             \ window.
  49.     actW 0exit
  50.     disable: actW  0 -> actW  ;m
  51.  
  52. :m InitNewWindow:
  53.     set: self  initfont  true  put: alive
  54.     ;m
  55.  
  56. public
  57.  
  58. :m CLOSE:
  59.     get: alive  0exit
  60.     ^base  call CloseWindow
  61.     tw -> saveActW    \ in case we are switched out (and sending close: message via QE)
  62.     clear: alive ;m
  63.     
  64.  
  65. :m NEW: { tAddr tLen procID vis goAway \ s255 -- }    \ 04Jul93 DBH
  66.  
  67.   \ Defines a new window on the heap with the specified features.
  68.   \ Not resource based.
  69.  
  70.     get: alive  ?exit            \ Out if already alive
  71.     ?disable_actW: self
  72.     tAddr tLen  str255  -> s255
  73.     0  ^base  bndsRect s255  vis Tbool
  74.     get: zoomFlg 8 and procID + makeint
  75.     inFront  goAway Tbool  0
  76.     call NewWindow  drop
  77.     initNewWindow: self
  78.     addr: self -> SaveActW    \ in case we were switched out   \ 08Jan94 dbh
  79.     addr: self -> wnd     \ 19Jan94 XXX
  80.     ;m
  81.  
  82. :m GETNEW:    \ ( resid -- )   Resource based new window.
  83.     get: alive  if  drop  exit  then    \ Out if already alive
  84.     ?disable_actW: self
  85.     0 swap makeint ^base  0
  86.     call GetNewWindow  drop
  87.     initNewWindow: self  ;m
  88.  
  89.  
  90. \ The DRAW: method is called, late-bound, whenever a window is updated.  The 
  91. \ implementation must begin with a BeginUpdate call and end with an EndUpdate 
  92. \ call.  We use the CallFirst/CallLast mechanism to ensure this, and also to draw 
  93. \ the grow icon if this is a growable window.  This means that any redefinition 
  94. \ of DRAW: in a subclass should not call DRAW: super, since this would lead to 
  95. \ BeginUpdate and EndUpdate being called more than once.
  96.  
  97. private
  98.  
  99. :m SETUP_DRAW:
  100.     savePort
  101.     set: self    \ Save port, reset to this window
  102.     ^base  call BeginUpdate
  103.     clear: portRect    \ 12Jun93 DBH, match Chernicoff
  104.     ;m
  105.  
  106. :m WINDUP_DRAW:
  107.     get: growFlg
  108.     IF
  109.         ^base  call DrawGrowIcon
  110.     THEN
  111.     ^base  call EndUpdate
  112.     restport ;m
  113.  
  114. callFirst SETUP_DRAW:
  115. callLast WINDUP_DRAW:
  116.  
  117. public
  118.  
  119. :m DRAW:  ;m
  120.  
  121. :m SELECT:    \ Makes this the front window.
  122.     ^base  call SelectWindow ;m
  123.  
  124. \ The idle: method is called for the frontmost window, whenever a null event occurs.  NULL-EVT is the normal word which sends idle:.  In subclasses we redefine this method to do things like calling TEidle, which have to be done periodically.  The Idle handler is also called, which allows a window-specific action to be taken.  In the class Window itself, this is all we do.
  125.  
  126. :m IDLE: ;m
  127.  
  128. :m ENABLE:    \ Handles an activate event.
  129.     set: self
  130.     get: growFlg  IF  ^base  call DrawGrowIcon  THEN
  131.     ;m
  132.  
  133. :m DISABLE:    \ Handles a deactivate event.
  134.     get: growFlg
  135.     IF                \ Erase grow icon
  136.         getRect: self  put: tempRect
  137.         getBotX: tempRect  14 -  putTopX: tempRect
  138.         getBotY: tempRect  14 -  putTopY: tempRect
  139.         clear: tempRect
  140.     THEN
  141.     ;m
  142.  
  143. :m ACTIVE:    \ ( -- b )  Is this window active ?
  144.     0  call FrontWindow  ^base  =  ;m
  145.  
  146. :m ALIVE:    \ ( -- b )  Is this window alive?
  147.     get: alive  ;m
  148.  
  149. :m DRAG:        \ Handles a drag region click
  150.     setLimits: self  \ Omit in subclasses which need custom drag limits
  151.     get: dragFlg  0exit
  152.     ^base  whrFEv  dragRect
  153.     call DragWindow  ;m
  154.  
  155.  
  156. :m SETSIZE:        \ ( w h -- )  Resizes window and accumulates update regions.
  157.     pack  ^base  swap  true makeint
  158.     call SizeWindow ;m
  159.  
  160. :m MOVE: \ ( xg yg -- )  Moves the window to x and y global coordinates
  161.     pack  ^base  swap
  162.     false makeint    \  pass false to indicate this is the active port
  163.     call MoveWindow  ;m
  164.  
  165. :m CONTENT:    \ Handles a content click.
  166.     active: self
  167.     NIF    select: self
  168.     THEN
  169.     set: super ;m    \ 14Jun93 DBH deviate from Chernicoff
  170.  
  171. :m TITLE:    \ ( addr len -- )  Sets the title of the window.
  172.     str255  ^base  swap  call SetWTitle  ;m
  173.  
  174. :m GETTITLE:    \ ( -- addr len )  Returns title of window.
  175.     ^base  buf255  call GetWTitle
  176.     buf255 count   ;m
  177.  
  178. :m MAXX:    \ ( -- x )  Returns the x coordinate value corresponding to
  179.         \  the window being moved to the right of the screen.
  180.     screenbits drop nip nip
  181.     size: portRect  drop  -  ;m
  182.  
  183. :m MAXY:    \ ( -- y )
  184.     screenbits nip nip nip
  185.     size: portRect  nip  -  ;m
  186.  
  187.  
  188. :m KEY:        \ ( c -- )  May be used in subclasses to do something with
  189.         \  typed keys.  Here, we just drop it.
  190.     drop  ;m
  191.  
  192.  
  193. :m SHOW:    ^base  call ShowWindow  ;m
  194.  
  195. :m HIDE:    ^base  call HideWindow  ;m
  196.  
  197. :m setbounds:    ( l t r b -- )
  198.     put: bndsRect ;m
  199.  
  200. :m CLASSINIT:
  201.     50 50 300 300 setbounds: self
  202.     true  put: dragFlg  ;m
  203.  
  204. :m setGrow: ( l t r b T | F -- )
  205.     dup put: growflg
  206.     IF
  207.         put: growRect
  208.     THEN ;m
  209.  
  210. :m setDrag: ( l t r b T | F -- )
  211.     dup put: dragFlg
  212.     IF
  213.         put: dragRect
  214.     THEN ;m
  215.  
  216. :m setzoom: ( b -- )
  217.     put: zoomFlg ;m
  218.  
  219. :m TEST:
  220.     screenbits true setgrow: self
  221.     true setzoom: self
  222.     " Test"  docWind  true true  new: [self]  ;m
  223.  
  224. \ We follow Chernicoff's ( vII p.107 ) recommended way of doing a zoom.
  225. :m ZOOM:  { part -- }
  226.     word0    \ room for result
  227.     ^base
  228.     WHRFEV \ will become where: fevent when event is loaded
  229.     part makeint  call TrackBox  i->l
  230.     IF    
  231.         set: super    \ 13Jun93 DBH deviate from Chernicoff
  232.         clear: portRect
  233.         ^base  part makeint  word0  call ZoomWindow
  234.         update: portrect    \ force update of window's contents
  235.     THEN  ;m
  236.  
  237. \ We follow Chernicoff's ( vII p.106 ) recommended way of doing a grow.
  238. :m GROW:  \ Handles a grow region click.
  239.     setLimits: self        \ will set growRect
  240.                     
  241.     0                \ room for result
  242.     ^base            \ whichWindow
  243.     WHRFEV \ will become where: fevent when event is loaded
  244.     growRect
  245.     call GrowWindow  dup { newSize -- }
  246.     IF    \ Size was changed if newSize is non-zero
  247.     set: super    \ 13Jun93 DBH  deviate from Chernicoff
  248.     clear: portrect
  249.     newSize unpack  setsize: self
  250.     update: portrect    \ force update of window's contents
  251.     THEN
  252.     ;m
  253.  
  254. :m erase:
  255.     saveport
  256.     set: super
  257.     clear: portrect
  258.     restport ;m
  259.     
  260.     
  261. ;class
  262.  
  263. endload
  264.  
  265. *** EXAMPLE USE
  266.  
  267. :class testWin super{ primitiveWin }
  268.  
  269. :m draw:
  270.     30 30 60 60 put: temprect
  271.     draw: temprect ;m
  272. ;class
  273.  
  274. testWin w1
  275. test: w1
  276.  
  277. testWin w2
  278. test: w2
  279.  
  280.  
  281.  
  282.